home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / pgpGpg.tcl.z / pgpGpg.tcl
Text File  |  2002-07-08  |  17KB  |  466 lines
  1. # pgpGpg.tcl
  2.  
  3. # $Log: pgpGpg.tcl,v $
  4. # Revision 1.12  2000/06/15 17:03:11  valdis
  5. # Add X-Mailer: change, fix PGP Comment: line...
  6. #
  7. # Revision 1.11  2000/04/18 18:38:33  valdis
  8. # Fix quote character to use ascii rather than iso8859-ish one
  9. #
  10. # Revision 1.10  2000/02/07 13:23:34  gruber
  11. # fixed run twice function to work with now short keyids
  12. #
  13. # Revision 1.9  1999/10/25 15:38:39  kchrist
  14. # Added a dropKeys pattern to pgpGPG.tcl.
  15. #
  16. # Simplified PGP GUI by removing "detached" signature option. Problem
  17. # was that MIME+standard includes a copy of the message being signed
  18. # in the signature attachement. What really should be used is
  19. # MIME+detached. Decided to overload the meaning of "standard". If
  20. # the format is plain, standard means "binary". If the format is
  21. # anything else, standard means "detached". Less flexibility but
  22. # better chances of "doing the right thing".
  23. #
  24. # Revision 1.8  1999/09/30 03:51:07  kchrist
  25. # pgp($v,cmd_Beauty) was getting in the way of pgp($v,cmd_User) for
  26. # v=gpg so I had to rearrange things a bit.
  27. #
  28. # Revision 1.7  1999/09/27 23:18:45  kchrist
  29. # More PGP changes. Consolidated passphrase entry to sedit field or
  30. # pgpExec routine. Made the pgp-sedit field aware of pgp(keeppass)
  31. # and pgp(echopass). Moved pgp(keeppass), pgp(echopass) and
  32. # pgp(grabfocus) to PGP General Interface. Fixed a minor bug left
  33. # over from my previous GUI changes. Made pgp-sedit field appear and
  34. # disappear based on its enable preference setting.
  35. #
  36. # Revision 1.6  1999/08/24 15:51:07  bmah
  37. # Patch from Kevin Christian to make email PGP key queries work, and
  38. # to make key attachment RFC 2015 compliant.
  39. #
  40. # Revision 1.5  1999/08/13 15:10:06  bmah
  41. # One more try at fixing the problems with 8-byte GPG keyIDs, with a
  42. # patch from Kevin.Christian@lsil.com.
  43. #
  44. # Revision 1.4  1999/08/13 00:39:05  bmah
  45. # Fix a number of key/passphrase management problems:  pgpsedit now
  46. # manages PGP versions, keys, and passphrases on a per-window
  47. # basis.  Decryption now works when no passphrases are cached.
  48. # One timeout parameter controls passphrases for all PGP
  49. # versions.  seditpgp UI slightly modified.
  50. #
  51. # Revision 1.3  1999/08/11 04:09:20  bmah
  52. # Fix problems caused by GPG returning key IDs that are 8 bytes long,
  53. # when exmh (and keyservers) like to work with 4-byte key IDs.
  54. #
  55. # Revision 1.2  1999/08/03 04:05:54  bmah
  56. # Merge support for PGP2/PGP5/GPG from multipgp branch.
  57. #
  58. # Revision 1.1.4.1  1999/06/14 20:05:15  gruber
  59. # updated multipgp interface
  60. #
  61. # Revision 1.1  1999/06/14 15:14:53  markus
  62. # added files
  63. #
  64. # Revision 1.4  1998/12/14 19:22:42  markus
  65. # modulepath, untrusted problem, toplevel
  66. #
  67. # Revision 1.3  1998/12/07 16:10:20  markus
  68. # fixed compressalgo handling
  69. #
  70. # Revision 1.2  1998/12/06 16:23:44  markus
  71. # DecryptExpect and subkey support
  72. #
  73. # Revision 1.1.1.1  1998/11/24 22:34:46  markus
  74. # Initial revision
  75. #
  76.  
  77. #######################################################################
  78. # GNUPG CONFIG
  79.  
  80. proc Pgp_gpg_Init {} {
  81. global pgp
  82. ###
  83.  
  84. # Yes, we need network keyfetching
  85. Pgp_WWW_Init
  86.  
  87. set pgp(pref,HKPkeyserverUrl) { HKPkeyserverUrl HKPKeyServerUrl {keys.pgp.com}
  88. {Horowitz Key Protocol Server}
  89. "The hkp (Horowitz Key Protokol) is a subset of the http.
  90. It's used to tranfer keys to and from a keyserver.
  91. Give here a hkp server name." }
  92.  
  93.  
  94. # Needed for Preferences
  95. set pgp(gpg,description) "GNUPG is a free GPLed PGP clone written by Werner Koch"
  96. set pgp(gpg,prefs) [list rfc822 \
  97.                          choosekey runtwice cacheids minmatch showinline \
  98.                          shortmsgs autoextract \
  99.                          keyserver keyquerymethod HKPkeyserverUrl keyserverUrl \
  100.                          keyothermethod ]
  101.  
  102. # this is called when preferences are set
  103. proc Pgp_gpg_Preferences {} {
  104.     global exmh pgp
  105.     # GnuPG algorithms and algorithm modules
  106.     set label $pgp(gpg,fullName)
  107.     Preferences_Add "$label interface" {} [list \
  108.                 [list pgp(gpg,comment) gpgComment \
  109. "Exmh [set exmh(version)]" "GnuPG Comment" \
  110. "Specify the comment GnuPG should put in the comment field
  111. of encrypted or signed text."] \
  112.                 [list pgp(gpg,modulepath) gpgModulePath \
  113. {/usr/local/lib/gnupg} "GnuPG Modules Path" \
  114. "GnuPG is able to dynamically load cipher, digest, pubkey etc.
  115. algorithm extension modules.
  116. Specify a colon (:) separated list of directories, where exmh should
  117. look for extension modules."] \
  118.                 [list pgp(gpg,ciphermods) gpgCipherMods \
  119. {skipjack idea} "GnuPG Cipher Modules" \
  120. "The Cipher Algorithm modules, exmh should look for
  121. in the Modules Path."] \
  122.                 [list pgp(gpg,digestmods) gpgDigestMods \
  123. {tiger} "GnuPG Digest Modules" \
  124. "The Digest Algorithm modules, exmh should look for
  125. in the Modules Path."] \
  126.                 [list pgp(gpg,pubkeymods) gpgPubkeyMods \
  127. {rsa} "GnuPG PubKey Modules" \
  128. "The Public Key Algorithm modules, exmh should look for
  129. in the Modules Path."] \
  130.                 [list pgp(gpg,pgp5compatibility) gpgPgp5Compatibility \
  131. ON "PGP 5.0 Compatibility" \
  132. "You MUST have enabled this if you want that GnuPG produces
  133. PGP 5.0 compatible messages.
  134. Having this enabled, you don't need PGP 5.0 any more." ] ]
  135.  
  136.     # Before we can build the algorithm choice preferences part
  137.     # we need to examine, which modules are installed on the system
  138.     # and build a complete list of algos
  139.     Pgp_Gpg_Algorithms
  140.  
  141.     # preferences
  142.     Preferences_Add "$label interface" {} [list \
  143.                 [list pgp(gpg,cipheralgo) gpgCipherAlgo \
  144. [concat CHOICE $pgp(gpg,cipheralgos)] "Default Cipher Algo" \
  145. "Your preferred cipher algorithm."] \
  146.                 [list pgp(gpg,digestalgo) gpgDigestAlgo \
  147. [concat CHOICE $pgp(gpg,digestalgos)] "Default Digest Algo" \
  148. "Your preferred digest algorithm."] \
  149.                 [list pgp(gpg,compressalgo) gpgCompressAlgo \
  150. [concat CHOICE $pgp(gpg,compressalgos)] "Default Compress Algo" \
  151. "The algorithm, GnuPG uses to compress the text before encrypting.
  152. You have the choice between the ZIP (RFC1951)
  153. and the ZLIB (RFC1950) algo. ZIP is used by PGP(2/5).
  154. If you choose none, the text is left uncompressed." ] ]
  155.     } 
  156.  
  157.  
  158. #######################################################################
  159. # GPG BASIC CONFIG
  160. # builtin gpg algos
  161. set pgp(gpg,cipheralgos) {3des cast5 blowfish twofish}
  162. set pgp(gpg,digestalgos) {sha1 md5 ripemd160}
  163. set pgp(gpg,compressalgos) {zip zlib none}
  164. set pgp(gpg,pubkeyalgos) {}
  165. # module files
  166. set pgp(gpg,ciphermodfiles) {}
  167. set pgp(gpg,digestmodfiles) {}
  168. set pgp(gpg,pubkeymodfiles) {}
  169. #######################################################################
  170.  
  171. # Searches Algorithms
  172. proc Pgp_Gpg_Algorithms {} {
  173.     global pgp
  174.     set wd [pwd]
  175.     foreach path [split $pgp(gpg,modulepath) :] {
  176.         set path [string trim $path]
  177.         catch {
  178.             cd $path
  179.             foreach file [glob -nocomplain *] {
  180.             if { ![file isdirectory $file] } {
  181.             if {[lsearch $pgp(gpg,ciphermods) $file] >= 0} {
  182.                 lappend pgp(gpg,cipheralgos) $file
  183.                         lappend pgp(gpg,ciphermodfiles) ${path}/$file
  184.             } elseif {[lsearch $pgp(gpg,digestmods) $file] >= 0} {
  185.                 lappend pgp(gpg,digestalgos) $file
  186.                         lappend pgp(gpg,digestmodfiles) ${path}/$file
  187.             } elseif {[lsearch $pgp(gpg,pubkeymods) $file] >= 0} {
  188.                 lappend pgp(gpg,pubkeyalgos) $file
  189.                         lappend pgp(gpg,pubkeymodfiles) ${path}/$file
  190.                     }
  191.                 }
  192.         }
  193.         }
  194.     }
  195.     cd $wd
  196. }
  197.  
  198. # Simple Dialog Box to choose Algorithms
  199. proc Pgp_gpg_ChooseAlgos {} {
  200.     global pgp
  201.     if [winfo exists .gregor] {
  202.         return
  203.     }
  204.     set t [toplevel .gregor]
  205.     wm title $t "Default Algorithms"
  206.     wm resizable $t 0 0
  207.     set m1 [frame $t.main1]
  208.     pack $m1 -side left
  209.     set m2 [frame $t.main2]
  210.     pack $m2 -side left
  211.     # Cipheralgo
  212.     set f [frame $m2.frame1]
  213.     pack $f -side top -expand 1 -fill x
  214.     set l [label $m1.cipher -text "Default cipheralgo"]
  215.     pack $l -side top
  216.     foreach algo $pgp(gpg,cipheralgos) {
  217.         set r [radiobutton $f.$algo -variable pgp(gpg,cipheralgo) \
  218.                            -text $algo -value $algo]
  219.         pack $r -side left
  220.     }
  221.     # Digestalgo
  222.     set f [frame $m2.frame2]
  223.     pack $f -side top -expand 1 -fill x
  224.     set l [label $m1.digest -text "Default digestalgo"]
  225.     pack $l -side top
  226.     foreach algo $pgp(gpg,digestalgos) {
  227.         set r [radiobutton $f.$algo -variable pgp(gpg,digestalgo) \
  228.                            -text $algo -value $algo]
  229.         pack $r -side left
  230.     }
  231.     # Compressalgo
  232.     set f [frame $m2.frame3]
  233.     pack $f -side top -expand 1 -fill x
  234.     set l [label $m1.compress -text "Default compressalgo"]
  235.     pack $l -side top
  236.     foreach algo $pgp(gpg,compressalgos) {
  237.         set r [radiobutton $f.$algo -variable pgp(gpg,compressalgo) \
  238.                            -text $algo -value $algo]
  239.         pack $r -side left
  240.     }
  241.     # OK
  242.     set b [button $f.ok -text "OK" -command "destroy $t"]
  243.     pack $b -side right
  244. }
  245.  
  246. # Forms the standard flags and arguments of the commandline
  247. proc Pgp_Gpg_Arglist {} {
  248.     global pgp
  249.     set modfiles \
  250.          [concat $pgp(gpg,ciphermodfiles) \
  251.                  $pgp(gpg,digestmodfiles) \
  252.                  $pgp(gpg,pubkeymodfiles) ]
  253.     ldelete modfiles {}
  254.     set arglist [list --no-greeting --comment $pgp(gpg,comment)]
  255.     # Take it
  256.     if {$pgp(gpg,pgp5compatibility)} {
  257.         lappend arglist --force-v3-sigs
  258.         # default: cast5
  259.         switch $pgp(gpg,cipheralgo) {
  260.             3des  {}
  261.             cast5 {}
  262.             idea  {}
  263.             default {set pgp(gpg,cipheralgo) cast5}
  264.         }
  265.         # default: sha1
  266.         switch $pgp(gpg,digestalgo) {
  267.             md5  {}
  268.             sha1 {}
  269.             default {set pgp(gpg,digestalgo) sha1}
  270.         }
  271.         switch $pgp(gpg,compressalgo) {
  272.             zip {}
  273.             default {set pgp(gpg,compressalgo) zip}
  274.         }
  275.     }
  276.     foreach modfile $modfiles {
  277.         set arglist [concat $arglist [list \
  278.                      --load-extension $modfile] ]
  279.     }
  280.     set arglist [concat $arglist [list \
  281.                      --cipher-algo $pgp(gpg,cipheralgo) \
  282.                      --digest-algo $pgp(gpg,digestalgo) ] ]
  283.     # compressalgo
  284.     switch $pgp(gpg,compressalgo) {
  285.         zip  { set arglist [concat $arglist --compress-algo 1] }
  286.         zlib { set arglist [concat $arglist --compress-algo 2] }
  287.         none { set arglist [concat $arglist -z 0] }
  288.     }
  289.     ldelete arglist {}
  290.     return $arglist
  291. }
  292.  
  293.  
  294. #######################################################################
  295. # Flags, Commands, Patterns, Settings
  296. #
  297.  
  298. # Should config file be parsed
  299. set pgp(gpg,parse_config) 0
  300.  
  301. #######
  302. # Exec
  303. #############
  304. # Exec_Batch
  305. # Batchmode flags
  306. set pgp(gpg,flags_batch) {--batch --status-fd 2 [Pgp_Gpg_Arglist]}
  307. #
  308. proc Pgp_gpg_PassFdSet {} {
  309.     upvar tclcmd tclcmd
  310.     set tclcmd [linsert $tclcmd 2 --passphrase-fd 0]
  311. }
  312. #
  313. proc Pgp_gpg_PassFdUnset {} {
  314. }
  315.  
  316. ###################
  317. # Exec_Interactive
  318. # Interactive flags
  319. set pgp(gpg,flags_interactive) {[Pgp_Gpg_Arglist]}
  320. # Cleanup output
  321. set pgp(gpg,cmd_cleanOutput) { regsub -all "\[\x0d\x07]" $output {} output
  322.                                    regexp "gpg:.*\$" $output output
  323.                                    set output [string trim $output] }
  324.  
  325. ###############
  326. # Exec_KeyList
  327. # List pubkeys args prototype
  328. set pgp(gpg,args_listPub) {--with-colons --list-keys \"$pattern\"}
  329. # List seckeys args prototype
  330. set pgp(gpg,args_listSec) {--with-colons --list-secret-keys \"$pattern\"}
  331. # Pattern that matches out revoked and nonvalid keys
  332. set pgp(gpg,pat_dropKeys) {(^|\n)(pub|sub|sec|ssb|uid):[dren]:[^\n]+}
  333. # Where to split up the listKeys raw output to form a list
  334. set pgp(gpg,pat_splitKeys) \n
  335. # Patterns that match out interesting keys
  336. set pgp(gpg,pat_keySec) \
  337.                 {^(pub|sec):[^:]*:[^:]*:([^:]*):[0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F]([^:]+):[^:]*:[^:]*:[^:]*:[^:]*:([^:]+).*$}
  338. set pgp(gpg,pat_keySec_sub) \
  339.                 {^(ssb):[^:]*:[^:]*:([^:]+):[0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F]([^:]+):[^:]*:[^:]*:[^:]*:[^:]*:[^:]*.*$}
  340. set pgp(gpg,pat_keyPub) $pgp(gpg,pat_keySec)
  341. set pgp(gpg,pat_keyPub_sub) \
  342.                 {^(sub):[^:]*:[^:]*:([^:]+):[0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F]([^:]+):[^:]*:[^:]*:[^:]*:[^:]*:[^:]*.*$}
  343. set pgp(gpg,pat_uid) \
  344.                 {^(uid):[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:([^:]+).*$}
  345. # TclCmd to match out userid and keyid
  346. set pgp(gpg,cmd_keyMatch) { if [set match [regexp $keypattern $line {} {} algo keyid userid]] {
  347.                                 switch $algo {
  348.                                     1  {set algo RSA}
  349.                                     16 {set algo ELG}
  350.                                     17 {set algo DSA}
  351.                                     20 {set algo ELG}
  352.                                 }
  353.                             }
  354.                             set match }
  355. set pgp(gpg,cmd_keyMatch_sub) { if [set match [regexp $subkeypattern $line {} {} algo keyid]] {
  356.                                     switch $algo {
  357.                                         1  {set algo RSA}
  358.                                         16 {set algo ELG}
  359.                                         17 {set algo DSA}
  360.                                         20 {set algo ELG}
  361.                                     }
  362.                                 }
  363.                                 set match }
  364. set pgp(gpg,cmd_uidMatch) { regexp $uidpattern $line {} {} userid }
  365.  
  366. ###############
  367. # Exec_GetKeys
  368. set pgp(gpg,args_exportKey) {--export --armor --textmode -o $file $keyid}
  369.  
  370. ###############
  371. # Exec_Encrypt
  372. set pgp(gpg,args_encrypt) {[concat -eat -o $out [foreach id [Pgp_Misc_Map key {lindex $key 0} $tokeys] {lappend recips -r $id}; set recips] $in]}
  373.  
  374. ###################
  375. # Exec_EncryptSign
  376. set pgp(gpg,args_encryptSign) {[concat -east -o $out -u $keyid [foreach id [Pgp_Misc_Map key {lindex $key 0} $tokeys] {lappend recips -r $id}; set recips] $in]}
  377.  
  378. ############
  379. # Exec_Sign
  380. set pgp(gpg,args_signClear) {--clearsign --armor --textmode -u $keyid -o $out $in}
  381. set pgp(gpg,args_signBinary) {--sign --armor --textmode -u $keyid -o $out $in}
  382.  
  383. ####################
  384. # Exec_SignDetached
  385. set pgp(gpg,args_signDetached) {-abt -u $keyid -o $out $in}
  386.  
  387. #####################
  388. # Exec_CheckPassword
  389. set pgp(gpg,pat_checkError) "(BAD_PASSPHRASE\[^\n]+)\n"
  390.  
  391. #######################
  392. # Exec_DetDecryptKeyid
  393. set pgp(gpg,args_getDecryptKeyid) {--dry-run $in}
  394. set pgp(gpg,pat_getDecryptKeyid) "NEED_PASSPHRASE ........(........)"
  395. set pgp(gpg,pat_getDecryptSym) "NEED_PASSPHRASE_SYM"
  396.  
  397. ###############
  398. # Exec_Decrypt
  399. set pgp(gpg,args_decrypt) {-o $out $in}
  400.  
  401. ##################### >>>>>>>>>>>> DELETE
  402. # Exec_DecryptExpect
  403. #set pgp(gpg,expectpat,passprompt) "NEED_PASSPHRASE (\[^ \n]*)"
  404. #set pgp(gpg,expectpat,conventional) {NEED_PASSPHRASE_SYM}
  405. #set pgp(gpg,expectpat,publickey) "Do-Not-Match"
  406. #set pgp(gpg,expectpat,secretmissing) "NO_SECKEY"
  407. #set pgp(gpg,expectpat,nopgpfile) {BADARMOR|NODATA}
  408. #set pgp(gpg,cmd_DecryptExpect) {gpg --no-greeting --status-fd 2 -o $outfile $infile}
  409.  
  410. ##############
  411. # Exec_Verify
  412. set pgp(gpg,args_verifyOnly) {--verify $in}
  413. set pgp(gpg,args_verifyOut) {-o $out $in}
  414.  
  415. ######################
  416. # Exec_VerifyDetached
  417. set pgp(gpg,args_verifyDetached) {--verify $sig $text}
  418.  
  419. ###################
  420. # Exec_ExtractKeys
  421. set pgp(gpg,args_importKey) {--import $file}
  422.  
  423. #########################
  424. # ShowMessage keypattern
  425. set pgp(gpg,pat_validKeys) "\n?(ssb|pub|sec|sub|uid)\[^\n]*"
  426.  
  427. ##################
  428. # InterpretOutput
  429. # command that matches out keyid in pgp output
  430. set pgp(gpg,cmd_Keyid) {
  431.     if {[regexp {GOODSIG ([^ ]*)} $in {} pgpresult(keyid)]} {
  432.     } elseif {[regexp {BADSIG ([^ ]*)} $in {} pgpresult(keyid)]} {
  433.     } else {regexp {ERRSIG ([^ ]*)} $in {} pgpresult(keyid)}
  434.  
  435.     # Keyservers like only the last four octets of the keyid.
  436.     if {[info exists pgpresult(keyid)]} {
  437.     set keyidLength [string length $pgpresult(keyid)]
  438.     set pgpresult(keyid) [string range $pgpresult(keyid) [expr $keyidLength-8] $keyidLength]
  439.     }
  440. }
  441. # command that tailors output to be nice looking
  442. set pgp(gpg,cmd_Beauty) {
  443.     set pgpresult(msg) $in
  444.     regsub -all "\\\[GNUPG:\\\]\[^\n\]*\n*" $pgpresult(msg) {} pgpresult(msg)
  445.     regsub -all {gpg: } $pgpresult(msg) {} pgpresult(msg)
  446.     set pgpresult(msg) [string trim $pgpresult(msg)]
  447. }
  448. # patterns for interpreting output
  449. set pgp(gpg,pat_SecretMissing) {ENC_TO.*DECRYPTION_FAILED}
  450. set pgp(gpg,pat_PublicMissing) {ERRSIG}
  451. set pgp(gpg,pat_GoodSignature) {GOODSIG}
  452. set pgp(gpg,pat_Untrusted) {(TRUST_UNDEFINED|TRUST_NEVER)}
  453. set pgp(gpg,pat_BadSignature) {BADSIG}
  454. set pgp(gpg,pat_UnknownError) {ERROR}
  455. # command that matches out the Originator
  456. set pgp(gpg,cmd_User) {
  457.     regexp {(GOODSIG|BADSIG) [^ ]* ([^\n]*)} $in {} {} user
  458. }
  459.  
  460. ##################
  461. # WWW_QueryHKPKey
  462. set pgp(gpg,args_HKPimport) {--keyserver $server --recv-keys 0x$id}
  463.  
  464. ###
  465. }
  466.